perm filename TEMPL.SAI[PUB,TES]1 blob
sn#129309 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("TEMPL")
00200
00300 COMMENT
00400
00500 MACROs, PROCEDUREs, REPEATs, counter and response templates. If you
00600 don't find here what you are looking for, try file RESPS for
00700 responses, SORCE for source switching, CNTRS for counters.
00800
00900 ;
01000
01100 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE TEMPL! ;$"#
00200 BEGIN "TEMPL!"
00300 MAXTEMPLATE ← 5000 ; TES 8/19/74 ;
00400 END "TEMPL!" ;
00100 PUBLIC RECURSIVE PROCEDURE APPLYTOARGUMENTS(BOOLEAN DO!IT, PROCALL) ;$"#
00200 BEGIN TES 8/19/74 EXTRACTED FROM PASS TO HANDLE PROCEDURES AS WELL AS MACROS ;
00300 BOOLEAN WASLPAR, DUMSEMI ;
00400 INTEGER MACIX, MACSYM, ARGS, ARG, ARGSYM, NAMES, K ;
00500 MACIX ← IX ; MACSYM ← SYMB ; ARGS ← NUMARGS(MACIX) ; DUMSEMI ← FALSE ;
00600 IF ARGS THEN
00700 BEGIN "SCAN ARGS"
00800 STRING ARRAY ACTUAL[1:ARGS] ;
00900 IF NOT (WASLPAR ← NEXTSCH(<(>)) THEN INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
01000 comment , Back up. Pretend just passed comma. ; THISWD ← "," ; EMPTYTHAT ;
01100 NAMES ← NAMEPAR(MACIX) ; comment bit table for name parameters ;
01200 FOR ARG ← 1 THRU ARGS DO
01300 BEGIN "EACH ACTUAL"
01400 IF NOT ITSCH(<,>) THEN ACTUAL[ARG] ← NULL comment , omitted argument;
01500 ELSE BEGIN RD(TO!VISIBLE) ;
01600 IF NAMES LAND TWO(ARGS-ARG) = 0 THEN
01700 BEGIN PASS ; ACTUAL[ARG] ← E(NULL, NULL&'0) ; END
01800 ELSE BEGIN "CALL BY NAME"
01900 IF BRC NEQ """" THEN
02000 BEGIN comment , Unquoted Call-By-Name ;
02100 IF (K←BRC)="|" THEN RD(ONE!CHAR) ;
02200 ACTUAL[ARG]←RD(IF K="|" THEN TO!VBAR!SKIP
02300 ELSE IF WASLPAR THEN TO!COMMA!RPAR ELSE TO!TERQ!CR) ;
02400 IF BRC=CR AND NOT WASLPAR THEN
02500 BEGIN comment force a semicolon ;
02600 INPUTSTR ← ";" & INPUTSTR ;
02700 DUMSEMI ← TRUE ;
02800 END ;
02900 PASS ;
03000 END
03100 ELSE BEGIN PASS ; ACTUAL[ARG]←E(NULL,0) END ;
03200 END "CALL BY NAME"
03300 END
03400 END "EACH ACTUAL" ;
03500 WHILE ITSCH(<,>) DO
03600 BEGIN
03700 WARN("=",<"Too Many Arguments to "&SYM[MACSYM]>) ;
03800 PASS ; E(NULL, 0) ;
03900 END ;
04000 IF ITSCH(<)>) AND WASLPAR THEN BEGIN comment Easy case; END
04100 ELSE BEGIN
04200 IF WASLPAR THEN WARN("=",<"Missed ) After Macro Call">) ;
04300 comment Back Up -- SWICH only saves THATWD ;
04400 IF THATISFULL THEN comment Unlikely; INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
04500 IF THISISFULL AND NOT DUMSEMI THEN BEGIN THATWD ← LIT!ENTITY ← THISWD ;
04600 LIT!TRAIL ← IF THISTYPE<-1 THEN NULL ELSE SP ;
04700 THATTYPE ← THISTYPE MIN 0 END ELSE EMPTYTHAT ;
04800 END ;
04900 IF PROCALL THEN SWICH("RETURN(NULL);;",-2-BLNMS,0) ; TES 8/20/74 ;
05000 IF DO!IT THEN
05100 BEGIN "STACK ARGUMENTS"
05200 IF LAST + ARGS > SIZE THEN GROWNESTS ;
05300 FOR ARG ← 1 THRU ARGS DO
05400 SNEST[LAST + ARG] ← ACTUAL[ARG] ;
05500 LAST ← LAST + ARGS ;
05600 END "STACK ARGUMENTS" ;
05700 END "SCAN ARGS" ;
05800 IF PROCALL AND NOT ARGS THEN SWICH("RETURN(NULL);;",-2-BLNMS,0) ; TES 8/20/74 ;
05900 IF DO!IT THEN SWICH(SSTK[BODY(MACIX)], -1, ARGS)
06000 ELSE BEGIN THISWD ← "7" ; THISTYPE ← -1 END ; COMMENT, Replace by NULL ("") ;
06100 END "APPLYTOARGUMENTS" ;
00100 PUBLIC SIMPLE PROCEDURE DDONE(BOOLEAN RETURNS) ;$"#
00200 BEGIN TES 8/14/74 (DONE) 8/19/74 (RETURN);
00300 INTEGER B ; STRING VAL ; BOOLEAN GOT ;
00400 PASS ;
00500 IF ON THEN
00600 IF NOT RETURNS AND DEEPREPEATS=0 THEN WARN(NULL,"Ignored a DONE without a repeat")
00700 ELSE IF RETURNS AND DEEPPROCEDURES=0 THEN WARN(NULL, "Ignored a RETURN not in a PROCEDURE")
00800 ELSE
00900 BEGIN
01000 IF RETURNS THEN
01100 BEGIN
01200 DEEPPROCEDURES ← DEEPPROCEDURES - 1 ;
01300 IF ITSCH(<(>) THEN
01400 BEGIN COMMENT VALUE TO RETURN ;
01500 PASS ;
01600 VAL ← E(NULL, NULL) ;
01700 IF NOT ITSCH(")") THEN WARN(NULL, <"Missed ) after RETURN">) ;
01800 END
01900 ELSE VAL ← NULL ;
02000 END
02100 ELSE DEEPREPEATS ← DEEPREPEATS - 1 ;
02200 EMPTYTHIS ; EMPTYTHAT ; INPUTSTR ← NULL ;
02300 DO BEGIN
02400 WHILE LAST AND CHANSCAN(LAST) > -2 DO
02500 INPUTSTR ← SWICHBACK ;
02600 GOT ← RETURNS EQV EQU("RETURN(", STRSCAN(LAST)[1 TO 7]) ;
02700 STRSCAN(LAST) ← NULL ;
02800 IF NOT GOT THEN CHANSCAN(LAST)←-1 ;
02900 END UNTIL GOT ;
03000 B ← -2 - CHANSCAN(LAST) ;
03100 WHILE B<BLNMS DO
03200 CASE IF STARTS THEN 0 ELSE ENDCASE OF
03300 BEGIN
03400 BEGIN BLNMS←BLNMS-1 ; STARTS←STARTS-1 ; END ;
03500 BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN WARN("=","Missed END") END ;
03600 IF ENDBLOCK THEN WARN("=", "Missed END") ELSE
03700 BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN WARN("=","Missed END") END ;
03800 BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN MYEND ← TRUE ELSE WARN("=","Extra END") END ;
03900 END ;
04000 CHANSCAN(LAST) ← -1 ;
04100 INPUTSTR ← SWICHBACK ;
04200 PASS ;
04300 IF RETURNS THEN PROCVALUE ← VAL ;
04400 END ;
04500 END "DDONE" ;
00100 PUBLIC STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE; INTEGER ARGS, IBASE) ;$"#
00200 BEGIN
00300 STRING SEGMENT, IDENT, PSPCS, SPCS, FML, TXID, TX2 ;
00400 INTEGER SINDX, I, DEEP, PGMKS, REQRS ;
00500 LABEL FORMAL ;
00600 IF ITSCH(;) THEN PASS ; DEFINING ← NOT FORFILE ; comment, makes RD include line nos in result ;
00700 IF NOT ITSCH(⊂) AND NOT(ITSCH($) AND NEXTSCH(<(>))
00800 THEN BEGIN WARN("=",<"Missed Horseshoe, ↑P, OR $( in definition">) ; RETURN(NULL) END ;
00900 DEEP ← 1 ; SINDX ← SHIGH ;
01000 IF SHIGH+20>STSIZE THEN
01100 BEGIN
01200 SGROW(STBL,STBLIDA,STSIZE,100,"Definition") ;
01300 SMAKEBE(STBLIDA, STBL) ; ZEROSTRINGS(100, STBL[STSIZE-99]) ;
01400 END ;
01500 EMPTYTHIS ; comment For page label switch in LABELREF ;
01600 IF FORFILE THEN STBL[SINDX←SINDX+1] ← SRCLINE & "/" & SRCPAGE & TB & ALTMODE ;
01700 IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN
01800 BEGIN
01900 STBL[SINDX ← SINDX + 1] ← CRLF & SRCLINE & "/" & SRCPAGE & TB ;
02000 INPUTSTR ← INPUTSTR[3:∞] ;
02100 END ;
02200 PGMKS ← PAGEMARKS ; REQRS ← LAST ; TES 8/19/74 ;
02300 WHILE DEEP DO
02400 BEGIN "DEF BODY"
02500 SEGMENT ← RD(DEFN!TABLE) ;
02600 IF BRC = "⊂" OR BRC="$" AND INPUTSTR="(" AND LOP(INPUTSTR)="(" THEN
02700 BEGIN DEEP ← DEEP + 1 ; SEGMENT ← SEGMENT & "⊂" ; END
02800 ELSE IF BRC = "⊃" OR BRC=")" AND INPUTSTR="$" AND LOP(INPUTSTR)="$" THEN
02900 BEGIN DEEP ← DEEP - 1 ;
03000 SEGMENT ← SEGMENT & (IF DEEP THEN "⊃" ELSE SP) ;
03100 END
03200 ELSE IF BRC = "∃" THEN SEGMENT ← SEGMENT & (IF DEEP>1 THEN BRC ELSE NULL) & RD(ONE!CHAR)
03300 ELSE IF LENGTH(TXID←BRC) AND
03400 (LDB(SPCODE(BRC))=LCURLY OR
03500 LDB(SPCODE(BRC))=DOLLAR AND LDB(SPCODE(INPUTSTR))=LBRACK AND
03600 LENGTH(TXID←TXID&LOP(INPUTSTR))) THEN
03700 IF SUBSTVARIABLES THEN
03800 BEGIN "{..."
03900 SPCS ← TXID & RD(TO!VISIBLE) ;
04000 IDENT ← SCAN(INPUTSTR,ALPHA,DUMMY) ; PSPCS ← RD(TO!VISIBLE) ;
04100 IF BRC = RCBRAK OR BRC="]" AND INPUTSTR[2 FOR 1]="$"THEN
04200 BEGIN
04300 LOPP(INPUTSTR) ;
04400 IF BRC="]" THEN BEGIN TX2←"]$" ; LOPP(INPUTSTR) END ELSE TX2←RCBRAK ;
04500 SEGMENT ← SEGMENT &
04600 (IF FULSTR(IDENT) AND SIMLOOK(CAPITALIZE(IDENT))
04700 AND SYMTYPE<MACROTYPE THEN TES 11/29/73 ;
04800 IF SYMIX=IXPAGE THEN ALTMODE&"[@]"&
04900 LABELREF(0,
05000 IF SYMBOL=SYMPAGE THEN CTR!CHRS(IXPAGE)
05100 ELSE PATT!CHRS(IXPAGE))
05200 ELSE EVALV(IDENT, SYMIX, SYMTYPE)
05300 ELSE SPCS & IDENT & PSPCS & TX2)
05400 END
05500 ELSE SEGMENT ← SEGMENT & SPCS & IDENT & PSPCS ;
05600 END "{..."
05700 ELSE SEGMENT ← SEGMENT & TXID
05800 ELSE IF BRC = RCBRAK THEN
05900 IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN ELSE SEGMENT ← SEGMENT & BRC
06000 ELSE IF LDB(FAMILY(BRC)) = LETTQ THEN
06100 BEGIN "LETTER"
06200 IDENT ← (BRC+0) & SCAN(INPUTSTR, ALPHA, BRC) ;
06300 FOR I ← 1 THRU ARGS DO IF EQU(FML←SYM[ITBL[IBASE+I]], TXID←CAPITALIZE(IDENT)) THEN
06400 FORMAL: BEGIN IDENT ← VT & I ; DONE END
06500 ELSE IF 1 LEQ LENGTH(TXID)-LENGTH(FML) LEQ 2 THEN
06600 BEGIN "MAYBE UNDERLINED"
06700 INTEGER L, R ;
06800 L ← IF IDENT="_" THEN 1 ELSE 0 ; R ← IF IDENT[∞ FOR 1]="_" THEN 1 ELSE 0 ;
06900 IF EQU(FML, TXID[1+L TO ∞-R]) THEN
07000 BEGIN
07100 IF L THEN SEGMENT ← SEGMENT & "_" ;
07200 IF R THEN INPUTSTR ← "_" & INPUTSTR ;
07300 GO TO FORMAL ;
07400 END ;
07500 END "MAYBE UNDERLINED" ;
07600 SEGMENT ← SEGMENT & IDENT ;
07700 END "LETTER"
07800 ELSE SEGMENT ← SEGMENT & BRC ;
07900 STBL[SINDX ← SINDX+1] ← SEGMENT ;
08000 IF SINDX = SHIGH+20 THEN
08100 BEGIN
08200 SEGMENT ← STBL[SHIGH + 1] ;
08300 FOR I ← SHIGH + 2 THRU SINDX DO BEGIN SEGMENT ← SEGMENT & STBL[I] ; STBL[I]←NULL; END;
08400 SINDX ← SHIGH + 1 ; STBL[SINDX] ← SEGMENT ;
08500 IF DEEP THEN TES 8/19/74 CHECK FOR INFINITE TEMPLATE ;
08600 IF LENGTH(SEGMENT) > MAXTEMPLATE THEN
08700 BEGIN
08800 WARNLONG(SEGMENT, "A template is longer than " &
08900 CVS(MAXTEMPLATE) & " characters" & CRLF &
09000 "If you really have such a long one, increase the value of maxtemplate") ;
09100 STBL[SINDX] ← NULL ; DONE ;
09200 END
09300 ELSE IF PAGEMARKS > PGMKS THEN
09400 BEGIN
09500 WARNLONG(SEGMENT,
09600 "A template crosses a manuscript page mark (form feed)") ;
09700 STBL[SINDX] ← NULL ; DONE ;
09800 END
09900 ELSE IF LAST NEQ REQRS THEN
10000 BEGIN
10100 WARNLONG(SEGMENT, "A template crosses a file boundary (eof)") ;
10200 STBL[SINDX] ← NULL ; DONE ;
10300 END ;
10400 END ;
10500 END "DEF BODY" ;
10600 SEGMENT ← STBL[SHIGH+1] ; FOR I ← SHIGH+2 THRU SINDX DO SEGMENT ← SEGMENT & STBL[I] ;
10700 IF FORFILE THEN SEGMENT ← SEGMENT & LF ;
10800 DEFINING ← FALSE ; INPUTSTR ← ";" & INPUTSTR ; PASS ;
10900 RETURN(SEGMENT) ;
11000 END "DEFN" ;
00100 PUBLIC SIMPLE PROCEDURE DMACRO(INTEGER ODDONE) ;$"#
00200 TES 8/19/74 ODDONE= 0:RECURSIVE MACRO 1:MACRO 2:PROCEDURE;
00300 BEGIN COMMENT, OLD VERSION NOT GARBAGED BUT COULD BE ;
00400 INTEGER SIHIGH, MIX, ARGS, J, NAMES, NAME ; BOOLEAN ROTTEN ;
00500 SIHIGH ← IHIGH ; DPASS ; IF NOT THISISID THEN BEGIN WARN("=","Macro name not identifier") ; RETURN END ;
00600 IF THATISID THEN BEGIN "TWO WORD" THISWD ← THISWD & SP & THATWD ; RDENTITY ; END "TWO WORD" ;
00700 PUTI(1, SYMNUM(THISWD)) ; PASS ;
00800 IF ITSCH(<(>) THEN
00900 BEGIN "FORMALS"
01000 ROTTEN ← FALSE ; THISWD ← "," ; NAMES ← 0 ;
01100 DO BEGIN
01200 IF ITSCH(<,>) THEN DPASS
01300 ELSE BEGIN WARN("=","Missed comma in macro formal list") ; ROTTEN←TRUE END ;
01400 IF ITSCH(ε) THEN BEGIN DPASS ; NAME ← 0 ; END ELSE NAME ← 1 ;
01500 IF NOT THISISID THEN BEGIN WARN("=","Formal parameters must be identifiers") ; ROTTEN←TRUE END
01600 ELSE BEGIN PUTI(1, SYMB) ; NAMES ← 2*NAMES + NAME ; DPASS END ;
01700 END
01800 UNTIL ITSCH(<)>) OR ROTTEN ;
01900 IF ITSCH(<)>) THEN PASS ;
02000 END "FORMALS" ;
02100 IF ROTTEN OR NOT ON THEN BEGIN IHIGH ← SIHIGH ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
02200 ARGS ← IHIGH - SIHIGH - 1 ; BIND(DECLARE(ITBL[SIHIGH+1], MACROTYPE), MIX←PUSHI(MACROWDS,MACROTYPE)) ;
02300 NUMARGS(MIX) ← ARGS ; ODDMAC(MIX) ← ODDONE ; BODY(MIX) ← PUSHS(1,DEFN(FALSE, FALSE,ARGS,SIHIGH+1)) ;
02400 IHIGH ← SIHIGH ; NAMEPAR(MIX) ← NAMES ;
02500 END "DMACRO" ;
00100 PUBLIC SIMPLE PROCEDURE DREPEAT ;$"#
00200 BEGIN TES 8/14/74 ;
00300 STRING BOD ;
00400 PASS ;
00500 BOD ← DEFN(FALSE, FALSE, 0, 0) ;
00600 IF ON THEN
00700 BEGIN
00800 DEEPREPEATS ← DEEPREPEATS + 1 ;
00900 SWICH(BOD, -2-BLNMS, 0) ;
01000 SWICH(BOD, -1, 0) ;
01100 PASS ;
01200 END ;
01300 END "DREPEAT" ;
00100 PUBLIC RECURSIVE STRING PROCEDURE PROCSTATEMENT ;$"#
00200 IF THISTYPE = MACROTYPE THEN
00300 IF ODDMAC(IX)<2 THEN WARN(NULL,<"Unexpanded MACRO "&THISWD&" (PUB Bug)">)
00400 ELSE IF ON THEN
00500 BEGIN
00600 INTEGER PR ;
00700 PR←DEEPPROCEDURES←DEEPPROCEDURES+1;
00800 APPLYTOARGUMENTS(TRUE, TRUE);
00900 DO STATEMENT UNTIL DEEPPROCEDURES<PR;
01000 RETURN(TRUE) ;
01100 END
01200 ELSE BEGIN
01300 APPLYTOARGUMENTS(FALSE, FALSE) ;
01400 RETURN(TRUE) ;
01500 END
01600 ELSE RETURN(FALSE) ;
00100 PUBLIC SIMPLE PROCEDURE WARNLONG(STRING SEGM, MESG) ;$"#
00200 WARN(NULL, <MESG & CRLF &
00300 "[You probably omitted a template closer: )$ or ↑P or Horseshoe]"
00400 & CRLF & "The template began with:" & CRLF & SEGM[1 TO 70]>) ;
00100 FINISHED
00200
00300 ENDOF("TEMPL")